Visual Basic Controls

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / aepopup3 / data1.cab / Popup_Properties_6 / CommandBox.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1999-05-05 | 21.8 KB | 596 lines

VERSION 5.00 Object = "{4E36AC7F-0302-11D3-AFE0-B4CDD86B7B11}#1.0#0"; "AePopup6D.OCX" Begin VB.Form frmCommandBox ClientHeight = 3765 ClientLeft = 60 ClientTop = 60 ClientWidth = 7320 ControlBox = 0 'False LinkTopic = "Form1" MDIChild = -1 'True ScaleHeight = 3765 ScaleWidth = 7320 WindowState = 2 'Maximized Begin VB.PictureBox picFrame Appearance = 0 'Flat ClipControls = 0 'False ForeColor = &H80000008& Height = 3495 Left = 60 ScaleHeight = 231 ScaleMode = 3 'Pixel ScaleWidth = 475 TabIndex = 15 TabStop = 0 'False Top = 120 Width = 7155 Begin VB.PictureBox picCustomPopup Appearance = 0 'Flat ForeColor = &H80000008& Height = 495 Left = 2280 ScaleHeight = 31 ScaleMode = 3 'Pixel ScaleWidth = 19 TabIndex = 21 Top = 1200 Visible = 0 'False Width = 315 Begin VB.Label lblPopupPrompt Alignment = 2 'Center BackStyle = 0 'Transparent Height = 195 Left = 60 TabIndex = 23 Top = 240 Width = 195 End Begin VB.Label lblPopupItems BackColor = &H80000005& Height = 195 Index = 0 Left = 60 TabIndex = 22 Top = 60 Width = 195 End End Begin VB.Frame frmProperties Caption = "Properties" Height = 3250 Left = 2640 TabIndex = 17 Top = 60 Width = 4400 Begin VB.ComboBox cboTextAlignment Height = 315 HelpContextID = 514 ItemData = "CommandBox.frx":0000 Left = 2040 List = "CommandBox.frx":0013 Style = 2 'Dropdown List TabIndex = 5 Top = 720 Width = 1875 End Begin VB.ComboBox cboPictureAlignment Height = 315 HelpContextID = 514 ItemData = "CommandBox.frx":005C Left = 2040 List = "CommandBox.frx":006F Style = 2 'Dropdown List TabIndex = 7 Top = 1080 Width = 1875 End Begin VB.CheckBox chkShowFocus Caption = "Show &Focus" Height = 195 HelpContextID = 523 Left = 360 TabIndex = 11 Top = 2280 Width = 1275 End Begin VB.CheckBox chkComboWidth Caption = "Combo &Width" Enabled = 0 'False Height = 255 HelpContextID = 506 Left = 660 TabIndex = 9 Top = 1860 Width = 1335 End Begin VB.CheckBox chkHasComboButton Caption = "&Has Combo Button" Height = 255 HelpContextID = 520 Left = 360 TabIndex = 8 Top = 1560 Width = 1635 End Begin VB.TextBox txtCaption Height = 315 Left = 1380 TabIndex = 3 Top = 300 Width = 2535 End Begin VB.CheckBox chkShowBorder Caption = "Show &Border" Height = 195 HelpContextID = 523 Left = 1800 TabIndex = 12 Top = 2280 Width = 1275 End Begin AePopup6D.AeEntryBox aebWidth Height = 315 HelpContextID = 506 Left = 2040 TabIndex = 10 Top = 1860 Width = 1275 _ExtentX = 2249 _ExtentY = 556 Enabled = 0 'False Style = 0 ButtonCount = 2 Picture1 = 13 Action1 = 1 ButtonStyle1 = 0 ButtonRepeatRate1= 100 ToolTipText1 = "Increment" Picture2 = 14 Action2 = 2 ButtonStyle2 = 0 ButtonRepeatRate2= 100 ToolTipText2 = "Decrement" DataType = 3 End Begin AePopup6D.AeEntryBox aebPopupSymbol Height = 315 HelpContextID = 522 Left = 1920 TabIndex = 14 Top = 2700 Width = 1935 _ExtentX = 3413 _ExtentY = 556 Enabled = 0 'False AllowEdit = 0 'False Style = 0 Picture1 = 31 Action1 = 3 ButtonStyle1 = 0 ToolTipText1 = "Standard Images" ListCount = 32 ListNoVisibleItems= 14 ListItem1 = "aeNoSymbol" ListItem2 = "aeDownSymbol" ListItem3 = "aeUpSymbol" ListItem4 = "aeLeftSymbol" ListItem5 = "aeRightSymbol" ListItem6 = "aeCalendarSymbol" ListItem7 = "aeClockSymbol" ListItem8 = "aeSearchSymbol" ListItem9 = "aeNewSymbol" ListItem10 = "aeEllipsisSymbol" ListItem11 = "aeCarriageReturnSymbol" ListItem12 = "aeHelpSymbol" ListItem13 = "aeAsteriskSymbol" ListItem14 = "aePlusSymbol" ListItem15 = "aeMinusSymbol" ListItem16 = "aeTickSymbol" ListItem17 = "aeCrossSymbol" ListItem18 = "aeFirstSymbol" ListItem19 = "aeLastSymbol" ListItem20 = "aeMaximiseSymbol" ListItem21 = "aeMinimiseSymbol" ListItem22 = "aeCloseSymbol" ListItem23 = "aeStopSymbol" ListItem24 = "aeRecordSymbol" ListItem25 = "aePlaySymbol" ListItem26 = "aePauseSymbol" ListItem27 = "aeFastForwardSymbol" ListItem28 = "aeRewindSymbol" ListItem29 = "aeLEDOffSymbol" ListItem30 = "aeLEDRedSymbol" ListItem31 = "aeLEDGreenSymbol" ListItem32 = "aeComboSymbol" End Begin VB.Label lblProperties AutoSize = -1 'True Caption = "&Text Alignment:" Height = 195 Index = 3 Left = 360 TabIndex = 4 Top = 780 Width = 1095 End Begin VB.Label lblProperties AutoSize = -1 'True Caption = "P&icture Alignment:" Height = 195 Index = 4 Left = 360 TabIndex = 6 Top = 1140 Width = 1275 End Begin VB.Label lblWidthPxls AutoSize = -1 'True Caption = "pxls" ForeColor = &H80000010& Height = 195 Left = 3360 TabIndex = 18 Top = 1920 Width = 270 End Begin VB.Label lblProperties AutoSize = -1 'True Caption = "&Caption:" Height = 195 Index = 2 Left = 360 TabIndex = 2 Top = 360 Width = 585 End Begin VB.Label lblProperties AutoSize = -1 'True Caption = "Popup Sy&mbol:" Height = 195 Index = 5 Left = 360 TabIndex = 13 Top = 2760 Width = 1065 End End Begin VB.TextBox txtEvents Appearance = 0 'Flat BackColor = &H8000000F& BorderStyle = 0 'None Height = 1455 Left = 90 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 1 TabStop = 0 'False Text = "CommandBox.frx":00B8 Top = 1965 Width = 2415 End Begin AePopup6D.AeCommandBox acbAcbGraphical Height = 195 HelpContextID = 501 Left = 1560 TabIndex = 16 Top = 1380 Width = 645 _ExtentX = 1138 _ExtentY = 344 ForeColor = -2147483630 ShowBorder = 0 'False MaskColor = 16711680 Picture = "CommandBox.frx":00C1 PressedPicture = "CommandBox.frx":028B DisabledPicture = "CommandBox.frx":0455 HighlightPicture= "CommandBox.frx":061F Appearance = 2 TextAlignment = 2 ShowFocus = 0 'False End Begin AePopup6D.AeCommandBox acbMain Height = 975 HelpContextID = 501 Left = 300 TabIndex = 0 Top = 180 Width = 1995 _ExtentX = 3519 _ExtentY = 1720 Picture = "CommandBox.frx":07E9 Caption = "&Aebacus" TextAlignment = 0 PictureAlignment= 0 ListCount = 5 ListItem1 = "Apples" ListItem2 = "Oranges" ListItem3 = "Pairs" ListItem4 = "Bananas" ListItem5 = "Lemons" Menu = $"CommandBox.frx":0A7B End Begin AePopup6D.AeCommandBox acbClearEvents Height = 195 Left = 1950 TabIndex = 24 TabStop = 0 'False ToolTipText = "Clear events" Top = 1740 Width = 555 _ExtentX = 979 _ExtentY = 344 BackColor = -2147483632 ForeColor = -2147483628 Picture = "CommandBox.frx":0B53 Appearance = 2 ShowFocus = 0 'False End Begin VB.Label lblProperties AutoSize = -1 'True Caption = "Graphical effects:" Height = 195 Index = 7 Left = 120 TabIndex = 20 Top = 1380 Width = 1245 End Begin VB.Label lblEvents BackColor = &H80000010& Caption = "Events:" ForeColor = &H80000014& Height = 210 Left = 90 TabIndex = 19 Top = 1740 Width = 2415 End End Attribute VB_Name = "frmCommandBox" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit 'Windows API Private Type Rect '16 Bytes Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function DrawEdge Lib "user32" _ (ByVal hDC As Long, qrc As Rect, ByVal edge As Long, ByVal grfFlags As Long) As Long Private Const BF_LEFT = &H1 Private Const BF_TOP = &H2 Private Const BF_RIGHT = &H4 Private Const BF_BOTTOM = &H8 Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM) Private Const BF_FLAT = &H4000 ' For flat rather than 3D borders Private Const BF_SOFT = &H1000 ' For softer buttons Private Const BDR_RAISEDOUTER = &H1 Private Const BDR_SUNKENOUTER = &H2 Private Const BDR_RAISEDINNER = &H4 Private Const BDR_SUNKENINNER = &H8 Private Const M_S_CommandBoxWidth = 0 Private Const M_S_PropsLeft = 1 Private Const M_S_PropsHeight = 2 Private Const M_S_EventsHeight = 3 Private Const M_S_EventsWidth = 4 Private Const M_S_ClearEventsLeft = 5 Private m_Offsets(M_S_CommandBoxWidth To M_S_ClearEventsLeft) As Integer Private Const M_CustomPopupItemCount = 3 Private WithEvents m_PopupForm As AePopupForm Attribute m_PopupForm.VB_VarHelpID = -1 Public Property Let Style(ByVal New_Style As AeCommandBoxStyles) If New_Style = aeCommandButton Or New_Style = aeSwitchButton Then lblProperties(5).ForeColor = vb3DShadow aebPopupSymbol.Enabled = False Else lblProperties(5).ForeColor = vbWindowText aebPopupSymbol.Enabled = True End If 'hook into popup events only when the aeCustomPopup style selected If New_Style = aeCustomPopup Then Set m_PopupForm = acbMain.PopupForm Else Set m_PopupForm = Nothing End If acbMain.Style = New_Style End Property Private Sub acbClearEvents_Click() txtEvents.Text = "(none)" End Sub Private Sub acbMain_Click() p_AddEvent "Click" End Sub Private Sub acbMain_ComboClick() p_AddEvent "ComboClick" End Sub Private Sub acbMain_ListClick(ByVal Index As Integer) p_AddEvent "ListClick" & vbTab & CStr(Index) End Sub Private Sub acbMain_MenuClick(MenuItem As AePopup6D.AeMenuItem) p_AddEvent "MenuClick" & vbTab & CStr(MenuItem.Index) End Sub Private Sub acbMain_MenuHighlight(MenuItem As AePopup6D.AeMenuItem) p_AddEvent "MenuHighlight" & vbTab & CStr(MenuItem.Index) End Sub Private Sub acbMain_MenuPopup(Menu As AePopup6D.AeMenu) p_AddEvent "MenuPopup" End Sub Private Sub aebPopupSymbol_Change() If aebPopupSymbol.List.Index > 0 Then acbMain.PopupSymbol = aebPopupSymbol.List.Index - 1 End If End Sub Private Sub aebWidth_Change() acbMain.ComboWidth = aebWidth.Value End Sub Private Sub cboPictureAlignment_Click() acbMain.PictureAlignment = cboPictureAlignment.ListIndex End Sub Private Sub cboTextAlignment_Click() acbMain.TextAlignment = cboTextAlignment.ListIndex End Sub Private Sub chkComboWidth_Click() If chkComboWidth.Value = vbChecked Then aebWidth.Enabled = True lblWidthPxls.ForeColor = vbButtonText Else aebWidth.Enabled = False lblWidthPxls.ForeColor = vbGrayText aebWidth.Value = 0 End If End Sub Private Sub chkHasComboButton_Click() Dim b As Boolean b = (chkHasComboButton.Value = vbChecked) acbMain.HasComboButton = b If b Then chkComboWidth.Enabled = True Else chkComboWidth.Enabled = False chkComboWidth.Value = vbUnchecked End If End Sub Private Sub chkShowBorder_Click() acbMain.ShowBorder = (chkShowBorder.Value = vbChecked) End Sub Private Sub chkShowFocus_Click() acbMain.ShowFocus = (chkShowFocus.Value = vbChecked) End Sub Private Sub lblPopupItems_Click(Index As Integer) m_PopupForm.Value = Index m_PopupForm.Hide End Sub Private Sub lblPopupItems_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) 'highlight the current label Dim n As Integer For n = 0 To M_CustomPopupItemCount - 1 If Index = n Then lblPopupItems(n).BackColor = vbHighlight lblPopupItems(n).ForeColor = vbHighlightText Else lblPopupItems(n).BackColor = vbWindowBackground lblPopupItems(n).ForeColor = vbWindowText End If Next n 'update the label prompt If Index = -1 Then lblPopupPrompt.Caption = "" Else lblPopupPrompt.Caption = lblPopupItems(Index).Caption End If End Sub Private Sub m_PopupForm_Load(ByVal Modal As Boolean) p_AddEvent ("PopupForm_Load") End Sub Private Sub m_PopupForm_Unload(Cancel As Boolean, ByVal UnloadMode As Integer) If Not m_PopupForm.Cancelled Then p_AddEvent "PopupForm_UnLoad" & vbTab & CStr(m_PopupForm.Value) End If End Sub Private Sub picCustomPopup_Click() m_PopupForm.Cancelled = True m_PopupForm.Hide End Sub Private Sub picCustomPopup_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) lblPopupItems_MouseMove -1, 0, 0, 0, 0 End Sub Private Sub picCustomPopup_Paint() Dim uRect As Rect 'draw raised border uRect.Left = 0 uRect.Top = 0 uRect.Right = picCustomPopup.ScaleWidth uRect.Bottom = picCustomPopup.ScaleHeight DrawEdge picCustomPopup.hDC, uRect, BDR_RAISEDINNER Or BDR_RAISEDOUTER, BF_RECT 'draw prompt inset border uRect.Left = lblPopupPrompt.Left - 1 uRect.Top = lblPopupPrompt.Top - 1 uRect.Right = uRect.Left + lblPopupPrompt.Width uRect.Bottom = uRect.Top + lblPopupPrompt.Height DrawEdge picCustomPopup.hDC, uRect, BDR_SUNKENOUTER, BF_RECT End Sub Private Sub picCustomPopup_Resize() 'reposition the 3 labels and prompt label Dim n As Integer Dim iHeight As Integer Dim iWidth As Integer iHeight = lblPopupItems(n).Height iWidth = picCustomPopup.ScaleWidth For n = 0 To M_CustomPopupItemCount - 1 lblPopupItems(n).Move 2, n * iHeight + 2, iWidth - 4 Next n lblPopupPrompt.Move 8, M_CustomPopupItemCount * iHeight + 8, iWidth - 16, 16 End Sub Private Sub picFrame_Resize() 'reposition controls acbMain.Width = Abs(picFrame.ScaleWidth - m_Offsets(M_S_CommandBoxWidth)) frmProperties.Left = Abs(picFrame.ScaleWidth - m_Offsets(M_S_PropsLeft)) frmProperties.Height = Abs(picFrame.ScaleHeight - m_Offsets(M_S_PropsHeight)) txtEvents.Height = Abs(picFrame.ScaleHeight - m_Offsets(M_S_EventsHeight)) txtEvents.Width = Abs(picFrame.ScaleWidth - m_Offsets(M_S_EventsWidth)) lblEvents.Width = Abs(picFrame.ScaleWidth - m_Offsets(M_S_EventsWidth)) acbClearEvents.Left = Abs(picFrame.ScaleWidth - m_Offsets(M_S_ClearEventsLeft)) End Sub Private Sub txtCaption_Change() acbMain.Caption = txtCaption.Text End Sub 'Form Events '=========== Private Sub Form_Load() txtCaption.Text = acbMain.Caption cboTextAlignment.ListIndex = acbMain.TextAlignment cboPictureAlignment.ListIndex = acbMain.PictureAlignment chkHasComboButton.Value = Abs(acbMain.HasComboButton) chkComboWidth.Value = Abs(acbMain.ComboWidth <> 0) aebWidth.Value = acbMain.ComboWidth chkShowFocus.Value = Abs(acbMain.ShowFocus) chkShowBorder.Value = Abs(acbMain.ShowBorder) aebPopupSymbol.List.Index = acbMain.PopupSymbol + 1 'set up resizing frame With picFrame m_Offsets(M_S_CommandBoxWidth) = .ScaleWidth - acbMain.Width m_Offsets(M_S_PropsLeft) = .ScaleWidth - frmProperties.Left m_Offsets(M_S_PropsHeight) = .ScaleHeight - frmProperties.Height m_Offsets(M_S_EventsHeight) = .ScaleHeight - txtEvents.Height m_Offsets(M_S_EventsWidth) = .ScaleWidth - txtEvents.Width m_Offsets(M_S_ClearEventsLeft) = .ScaleWidth - acbClearEvents.Left .BorderStyle = 0 End With 'setup custom popup form Dim n As Integer lblPopupItems(n).Caption = "Undo 1 level" For n = 1 To M_CustomPopupItemCount Load lblPopupItems(n) lblPopupItems(n).Caption = "Undo " & CStr(n + 1) & " levels" lblPopupItems(n).Visible = True Next n With picCustomPopup .BorderStyle = 0 .Move .Left, .Top, 120, 70 End With acbMain.CreatePopupForm picCustomPopup.hWnd End Sub Private Sub Form_Resize() picFrame.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight End Sub 'Private Methods '============== Private Sub p_AddEvent(Caption As String) Dim sText As String sText = txtEvents.Text If Left$(sText, 6) = "(none)" Then sText = Caption Else sText = sText & vbCrLf & Caption End If txtEvents.Text = sText txtEvents.SelStart = Len(sText) End Sub